home *** CD-ROM | disk | FTP | other *** search
/ CU Amiga Super CD-ROM 24 / CU Amiga Magazine's Super CD-ROM 24 (1998)(EMAP Images)(GB)(Track 1 of 2)[!][issue 1998-07].iso / CUCD / Programming / SWI / source / lib / quintus.pl < prev    next >
Encoding:
Text File  |  1997-03-25  |  4.4 KB  |  210 lines
  1. /*  $Id: quintus.pl,v 1.16 1997/03/25 08:59:23 jan Exp $
  2.  
  3.     Copyright (c) 1990 Jan Wielemaker. All rights reserved.
  4.     jan@swi.psy.uva.nl
  5.  
  6.     Purpose: Quintus compatibility predicates
  7. */
  8.  
  9. :- module(quintus, 
  10.     [ unix/1
  11. %    , file_exists/1
  12.  
  13.     , abs/2
  14.     , sin/2
  15.     , cos/2
  16.     , tan/2
  17.     , log/2
  18.     , random/3
  19.  
  20.     , genarg/3
  21.  
  22.     , (mode)/1
  23.     , (public)/1
  24.     , (meta_predicate)/1
  25.     , no_style_check/1
  26.     , otherwise/0
  27.     , numbervars/3
  28.     , statistics/2
  29.     ]).
  30.  
  31.         /********************************
  32.         *      SYSTEM INTERACTION       *
  33.         *********************************/
  34.  
  35. %    unix(+Action)
  36. %    interface to  Unix.
  37.  
  38. unix(system(Command)) :-
  39.         shell(Command).
  40. unix(shell(Command)) :-
  41.         shell(Command).
  42. unix(shell) :-
  43.         shell.
  44. unix(access(File, 0)) :-
  45.         access_file(File, read).
  46. unix(cd) :-
  47.         chdir('~').
  48. unix(cd(Dir)) :-
  49.         chdir(Dir).
  50. unix(args(L)) :-
  51.     '$argv'(L).
  52. unix(argv(L)) :-
  53.     '$argv'(S),
  54.     maplist(to_prolog, S, L).
  55.  
  56. to_prolog(S, A) :-
  57.     name(S, L),
  58.     name(A, L).
  59.  
  60.  
  61. %    file_exists(+File)
  62. %    Succeeds if `File' exists as a file or directory in the Unix file
  63. %    system.
  64.  
  65. file_exists(File) :-
  66.     exists_file(File).
  67.  
  68.  
  69.         /********************************
  70.         *        META PREDICATES        *
  71.         *********************************/
  72.  
  73. %    otherwise/0
  74. %    For (A -> B ; otherwise -> C)
  75.  
  76. otherwise.
  77.  
  78.  
  79.         /********************************
  80.         *          ARITHMETIC           *
  81.         *********************************/
  82.  
  83. %    abs(+Number, -Absolute)
  84. %    Unify `Absolute' with the absolute value of `Number'.
  85.  
  86. abs(Number, Absolute) :-
  87.     Absolute is abs(Number).
  88.  
  89. %    Math library predicates
  90.  
  91. sin(A, V) :-      V is sin(A).
  92. cos(A, V) :-      V is cos(A).
  93. tan(A, V) :-      V is tan(A).
  94. log(A, V) :-      V is log(A).
  95. log10(X, V) :-      V is log10(X).
  96. pow(X,Y,V) :-      V is X**Y.
  97. ceiling(X, V) :-  V is ceil(X).
  98. floor(X, V) :-      V is floor(X).
  99. round(X, V) :-      V is round(X).
  100. sqrt(X, V) :-      V is sqrt(X).
  101. acos(X, V) :-      V is acos(X).
  102. asin(X, V) :-      V is asin(X).
  103. atan(X, V) :-      V is atan(X).
  104. atan2(Y, X, V) :- V is atan(Y, X).
  105. sign(X, V) :-      V is sign(X).
  106.  
  107. %    random(+Min, +Max, -Value)
  108.  
  109. random(Min, Max, Value) :-
  110.     Value is Min + random(Max).
  111.  
  112.          /*******************************
  113.          *    TERM MANIPULATION    *
  114.          *******************************/
  115.  
  116.  
  117. genarg(N, T, A) :-            % SWI-Prolog arg/3 is generic
  118.     arg(N, T, A).
  119.  
  120.          /*******************************
  121.          *        STATISTICS        *
  122.          *******************************/
  123.  
  124. :- recorda('$runtime', 0, _).
  125.  
  126. statistics(runtime, [Total, New]) :- !,
  127.     system:statistics(cputime, Time),
  128.     Total is integer(Time * 1000),
  129.     recorded('$runtime', Old, Ref),
  130.     New is Total - Old,
  131.     erase(Ref),
  132.     recorda('$runtime', Total, _).
  133. statistics(program, [InUse, _Free]) :- !,
  134.     system:statistics(heapused, InUse).
  135. statistics(heap, Stat) :- !,
  136.     statistics(program, Stat).
  137. statistics(global_stack, [InUse, Free]) :- !,
  138.     system:statistics(globalused, InUse),
  139.     system:statistics(globallimit, Limit),
  140.     Free is Limit - InUse.
  141. statistics(local_stack, [InUse, Free]) :- !,
  142.     system:statistics(localused, InUse),
  143.     system:statistics(locallimit, Limit),
  144.     Free is Limit - InUse.
  145. statistics(trail, [InUse]) :- !,
  146.     system:statistics(trailused, InUse).
  147.  
  148.  
  149.         /********************************
  150.         *          STYLE CHECK          *
  151.         *********************************/
  152.  
  153. q_style_option(single_var, singleton) :- !.
  154. q_style_option(Option, Option).
  155.  
  156. no_style_check(QOption) :-
  157.     q_style_option(QOption, SWIOption), 
  158.     style_check(-SWIOption).
  159.  
  160.         /********************************
  161.         *            OPERATORS          *
  162.         *********************************/
  163.  
  164. :- op(0, fy, not).
  165.  
  166.         /********************************
  167.         *         DIRECTIVES            *
  168.         *********************************/
  169.  
  170. % :- op(1150, fx, [(mode), (public)]).
  171.  
  172. mode(_).
  173. public(_).
  174.  
  175.  
  176.          /*******************************
  177.          *    TERM MANIPULATION    *
  178.          *******************************/
  179.  
  180. numbervars(Term, From, To) :-
  181.     numbervars(Term, '$VAR', From, To).
  182.  
  183.  
  184.         /********************************
  185.         *            MODULES            *
  186.         *********************************/
  187.  
  188. :- initialization op(1150, fx, (meta_predicate)).
  189.  
  190. :- module_transparent
  191.     (meta_predicate)/1, 
  192.     (meta_predicate1)/1.
  193.  
  194. meta_predicate((Head, More)) :- !, 
  195.     meta_predicate1(Head), 
  196.     meta_predicate(More).
  197. meta_predicate(Head) :-
  198.     meta_predicate1(Head).
  199.  
  200. meta_predicate1(Head) :-
  201.     Head =.. [Name|Arguments], 
  202.     member(Arg, Arguments), 
  203.     module_expansion_argument(Arg), !, 
  204.     functor(Head, Name, Arity), 
  205.     module_transparent(Name/Arity).
  206. meta_predicate1(_).        % just a mode declaration
  207.  
  208. module_expansion_argument(:).
  209. module_expansion_argument(N) :- integer(N).
  210.